home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d26 / cattest.arc / UUDEC.PAS < prev    next >
Pascal/Delphi Source File  |  1991-07-01  |  6KB  |  189 lines
  1. PROGRAM uudecode;
  2. {v1.1 Toad Hall Tweak, 9 May 90
  3.  - Reformatted in case, style, indentation, etc. to my preferences.
  4.  - Tweaked for Turbo Pascal v5.0
  5.  David Kirschbaum
  6.  Toad Hall
  7. }
  8. Uses  Dos,Crt;
  9. CONST
  10.   DefaultSuffix = '.uue';
  11.   OFFSET = 32;
  12. TYPE
  13.   Str80 = STRING[80];
  14. VAR
  15.   Infile: TEXT;
  16.   Fi    : FILE OF Byte;
  17.   Outfile: FILE OF Byte;
  18.   linenum: INTEGER;
  19.   Line: Str80;
  20.   size,remaining : longint;  {v1.1 REAL;}
  21. PROCEDURE Abort(Msg: Str80);
  22.   BEGIN
  23.     WRITELN;
  24.     IF linenum > 0 THEN WRITE('Line ', linenum, ': ');
  25.     WRITELN(Msg);
  26.     HALT
  27.   END; {of Abort}
  28. PROCEDURE NextLine(VAR S: Str80);
  29.   BEGIN
  30.     Inc(linenum);
  31.     {write('.');}
  32.     READLN(Infile, S);
  33.     Dec(remaining,LENGTH(S)-2);  {-2 is for CR/LF}
  34.     WRITE('bytes remaining: ',remaining:7,' (',
  35.           remaining/size*100.0:3:0,'%)',CHR(13));
  36.   END; {of NextLine}
  37. PROCEDURE Init;
  38.   PROCEDURE GetInFile;
  39.     VAR Infilename: Str80;
  40.     BEGIN
  41.       IF ParamCount = 0 THEN Abort ('Usage: uudecode <filename>');
  42.       Infilename := ParamStr(1);
  43.       IF POS('.', Infilename) = 0
  44.       THEN Infilename := CONCAT(Infilename, DefaultSuffix);
  45.       ASSIGN(Infile, Infilename);
  46.       {$I-}
  47.       RESET(Infile);
  48.       {$i+}
  49.       IF IOResult > 0 THEN Abort (CONCAT('Can''t open ', Infilename));
  50.       WRITELN ('Decoding ', Infilename);
  51.       ASSIGN(Fi,Infilename); RESET(Fi);
  52.       size := FileSize(Fi);
  53.       CLOSE(Fi);
  54. {      IF size < 0 THEN size:=size+65536.0; }
  55.       remaining := size;
  56.     END;  {of GetInFile}
  57.   PROCEDURE GetOutFile;
  58.     VAR
  59.       Header, Mode, Outfilename: Str80;
  60.       Ch: CHAR;
  61.     PROCEDURE ParseHeader;
  62.       VAR index: INTEGER;
  63.       PROCEDURE NextWord(VAR Word:Str80; VAR index: INTEGER);
  64.         BEGIN
  65.           Word := '';
  66.           WHILE Header[index] = ' ' DO BEGIN
  67.             Inc(index);
  68.             IF index > LENGTH(Header) THEN Abort ('Incomplete header')
  69.           END;
  70.           WHILE Header[index] <> ' ' DO BEGIN
  71.             Word := CONCAT(Word, Header[index]);
  72.             Inc(index);
  73.           END
  74.         END; {of NextWord}
  75.       BEGIN {ParseHeader}
  76.         Header := CONCAT(Header, ' ');
  77.         index := 7;
  78.         NextWord(Mode, index);
  79.         NextWord(Outfilename, index)
  80.       END; {of ParseHeader}
  81.     BEGIN {GetOutFile}
  82.       IF EOF(Infile) THEN Abort('Nothing to decode.');
  83.       NextLine (Header);
  84.       WHILE NOT ((COPY(Header, 1, 6) = 'begin ') OR EOF(Infile)) DO
  85.         NextLine(Header);
  86.       WRITELN;
  87.       IF EOF(Infile) THEN Abort('Nothing to decode.');
  88.       ParseHeader;
  89.       ASSIGN(Outfile, Outfilename);
  90.       WRITELN ('Destination is ', Outfilename);
  91.       {$I-}
  92.       RESET(Outfile);
  93.       {$I+}
  94.       IF IOResult = 0 THEN BEGIN
  95.         WRITE ('Overwrite current ', Outfilename, '? [Y/N] ');
  96.         REPEAT
  97.           Ch := Upcase(ReadKey);  {v1.1}
  98.         UNTIL Ch IN ['Y', 'N'];
  99.         WRITELN(Ch);
  100.         IF Ch = 'N' THEN Abort ('Overwrite cancelled.')
  101.       END;
  102.       REWRITE (Outfile);
  103.     END; {of GetOutFile}
  104.   BEGIN {Init}
  105.     linenum := 0;
  106.     GetInFile;
  107.     GetOutFile;
  108.   END; { init}
  109. FUNCTION Check_Line: BOOLEAN;
  110.   BEGIN
  111.     IF Line = '' THEN Abort ('Blank line in file');
  112.     Check_Line := NOT (Line[1] IN [' ', '`'])
  113.   END; {of Check_Line}
  114. PROCEDURE DecodeLine;
  115.   VAR
  116.     lineIndex, byteNum, count, i: INTEGER;
  117.     chars: ARRAY [0..3] OF Byte;
  118.     hunk: ARRAY [0..2] OF Byte;
  119. {    procedure debug;
  120.       var i: integer;
  121.       procedure writebin(x: byte);
  122.         var i: integer;
  123.         begin
  124.           for i := 1 to 8 do begin
  125.               write ((x and $80) shr 7);
  126.               x := x shl 1
  127.             end;
  128.           write (' ')
  129.         end;
  130.       begin
  131.         writeln;
  132.         for i := 0 to 3 do writebin(chars[i]);
  133.         writeln;
  134.         for i := 0 to 2 do writebin(hunk[i]);
  135.         writeln
  136.       end;      }
  137.   FUNCTION Next_Ch: CHAR;
  138.     BEGIN
  139.       Inc(lineIndex);
  140.       IF lineIndex > LENGTH(Line) THEN Abort('Line too short.');
  141.       IF NOT (Line[lineindex] IN [' '..'`'])
  142.       THEN Abort('Illegal character in line.');
  143. {     write(line[lineindex]:2);}
  144.       IF Line[lineindex] = '`' THEN Next_Ch := ' '
  145.                                ELSE Next_Ch := Line[lineIndex]
  146.     END; {of Next_Ch}
  147.   PROCEDURE DecodeByte;
  148.     PROCEDURE GetNextHunk;
  149.       VAR i: INTEGER;
  150.       BEGIN
  151.         FOR i := 0 TO 3 DO chars[i] := ORD(Next_Ch) - OFFSET;
  152.         hunk[0] := (chars[0] ShL 2) + (chars[1] ShR 4);
  153.         hunk[1] := (chars[1] ShL 4) + (chars[2] ShR 2);
  154.         hunk[2] := (chars[2] ShL 6) + chars[3];
  155.         byteNum := 0  {;
  156.         debug          }
  157.       END; {of GetNextHunk}
  158.     BEGIN {DecodeByte}
  159.       IF byteNum = 3 THEN GetNextHunk;
  160.       WRITE (Outfile, hunk[byteNum]);
  161.       {writeln(bytenum, ' ', hunk[byteNum]);}
  162.       Inc(byteNum)
  163.     END; {of DecodeByte}
  164.   BEGIN {DecodeLine}
  165.     lineIndex := 0;
  166.     byteNum := 3;
  167.     count := (ORD(Next_Ch) - OFFSET);
  168.     FOR i := 1 TO count DO DecodeByte
  169.   END; {of DecodeLine}
  170. PROCEDURE Terminate;
  171.   VAR Trailer: Str80;
  172.   BEGIN
  173.     IF EOF(Infile) THEN Abort ('Abnormal end.');
  174.     NextLine (trailer);
  175.     IF LENGTH (trailer) < 3 THEN Abort ('Abnormal end.');
  176.     IF COPY (trailer, 1, 3) <> 'end' THEN Abort ('Abnormal end.');
  177.     CLOSE (Infile);
  178.     CLOSE (Outfile)
  179.   END;  {of Terminate}
  180. BEGIN {uudecode}
  181.   Init;
  182.   NextLine(Line);
  183.   WHILE Check_Line DO BEGIN
  184.     DecodeLine;
  185.     NextLine(Line)
  186.   END;
  187.   Terminate
  188. END.
  189.